home *** CD-ROM | disk | FTP | other *** search
- /* T-Test 2 Means for Independent Samples */
-
- options results
- if ~show('P','TCALC') then do
- address command 'run turbocalc:turbocalc'
- address command 'waitforport TCALC'
- loadflag=1
- end
- address 'TCALC'
- 'DEFPUBSCREEN()'
- /* Add-in Rexx Math Library needed for some routines */
- signal on syntax
- if ~show('l','rexxmathlib.library') then
- call addlib('rexxmathlib.library',0,-30)
- if ~show('l','rexxreqtools.library') then
- call addlib('rexxreqtools.library',0,-30)
- if ~show('l','rexxsupport.library') then
- call addlib('rexxsupport.library',0,-30)
- /* add to library list */
- signal off syntax
-
- /* Start Main Routine */
- if loadflag=1 then 'Load()'
- 'ActivateWindow()'
- range=rtgetstring(,"Enter Cell Range for Input","Input Request") /*,,'rt_pubscrname="TCALC"')*/
- colon=pos(":",range)
- if colon=0 then do
- 'Message "Please select a range before executing this script"'
- 'DEFPUBSCREEN("Workbench")'
- exit
- end
-
- /* Find cell references and cell, column numbers */
- start_cell=substr(range,1,colon-1)
- end_cell=substr(range,colon+1)
- start_row=cellrow(start_cell)
- end_row=cellrow(end_cell)
- start_col=cellcol(start_cell)
- end_col=cellcol(end_cell)
- NRows=end_row-start_row+1
- NCols=end_col-start_col+1
- if NCols >2 then do
- 'Message "Only Two Samples Allowed"'
- 'DEFPUBSCREEN("Workbench")'
- exit
- end
- /* Get cell reference for output range */
- out_cell=rtgetstring(,"Enter Cell Reference for Output","Input Request") /*,,'rt_pubscrname="TCALC"')*/
- if out_cell="" then do
- 'DEFPUBSCREEN("Workbench")'
- exit
- end
- if length(out_cell)<2 | datatype(left(out_cell,1),'n') then do
- 'Message "Invalid cell reference"'
- 'DEFPUBSCREEN("Workbench")'
- exit
- end
- /* Suppress Screen Redraw to Speed Things Up */
- 'Refresh 0'
-
- /* Open a small output window on tcalc screen*/
- fo=0
- CR='0a'x
- DisplayMsg="Calculating...Please Wait."||CR||"User input is disabled during calculation."||CR
- if open(6Info, 'con:100/0/450/80/Progress/SCREEN TCALC', w) then do
- call writeln(6Info, DisplayMsg)
- fo=1
- end
- else do
- 'Message "TCALC Screen not available for Progress messages"'
- end
- CALL DELAY(150)
-
- /* Get cell references for top cell in each column */
- 'SelectCell' start_cell
- do col=start_col to end_col
- 'GetCursorPos'
- top_cell.col=result
- 'Column 1'
- end
-
- /* Get labels for later use on output */
- 'SelectCell' start_cell
- 'GetValue'
- testlabel=result
- testlabel=strip(testlabel)
- if datatype(testlabel,'n')=1 then do
- labelflag=0
- do x=1 to NCols
- title.x="Column "||x
- end
- end
- else do
- labelflag=1
- NRows=NRows-1
- do x=1 to NCols
- 'GetValue'
- str=result
- title.x=translate(strip(str),"_"," ")
- 'Column 1'
- end
- end
- if fo then call writech(6Info,"Progress...10 ")
-
- /* Get data from cell range */
- col=start_col
- lav=0
- tot=0
- count.=0
- total.=0
- do x=1 to NCols
- 'SelectCell' top_cell.col
- if labelflag=1 then 'CursorDown 1'
- do y=1 to NRows
- 'GetValue'
- valtest=result
- valtest=strip(valtest)
- if datatype(valtest,'n')=1 then do
- 'GetValue'
- val=result
- data.x.y=val
- tot=tot+val
- total.x=tot
- count.x=1+count.x
- end
- 'CursorDown 1'
- end
- col=col+1
- tot=0
- lav=0
- val=0
- end
- if fo then call writech(6Info,"20 ")
-
- /* Calculate Means */
- mean.=0
- do x=1 to NCols
- mean.x=total.x/count.x
- end
- if fo then call writech(6Info,"30 ")
-
- /* Calculate Sum of Squared Values */
- sumsq.=0
- do x =1 to NCols
- do y=1 to count.x
- sumsq.x=(sumsq.x)+(data.x.y)**2
- end
- end
- if fo then call writech(6Info,"40 ")
-
- /* Calculate Unbiased Estimate of Variance */
- Var=(((sumsq.1)-((total.1)**2/count.1))+((sumsq.2)-((total.2)**2/count.2)))/((count.1+count.2)-2)
- StDev=sqrt(Var)
- StErr=sqrt((VAR/count.1)+(VAR/count.2))
-
- /* Calculate t ratio */
- t=((mean.1)-(mean.2))/sqrt((Var/count.1)+(Var/count.2))
- if fo then call writech(6Info,"50 ")
-
- /* Calculate degrees of freedom */
- df=(count.1)+(count.2)-2
-
- /* Calculate T distribution function */
-
- P=PROBT(t,df)
- if t>=0 then P=1-P
- PT=P*2
- if fo then call writech(6Info,"60 ")
- /* Calculate T Critical */
-
- TCRIT1=TCRITICAL(.95,df)
- if fo then call writech(6Info,"70 ")
- TCRIT2=TCRITICAL(.99,df)
- if fo then call writech(6Info,"80 ")
- TCRIT3=TCRITICAL(.975,df)
- if fo then call writech(6Info,"90 ")
- TCRIT4=TCRITICAL(.995,df)
- if fo then do
- call writeln(6Info,"100")
- call writeln(6Info,"Writing output to window...")
- end
- /* Output */
- 'SelectCell' out_cell
- 'ColumnWidth 25'
- 'Put "T-Test: Two Means for Independent Samples"'
- 'Column 1'
- 'CursorDown 1'
- do x=1 to NCols
- 'GetCursorPos'
- first_cell.x=result
- title=""""||title.x||""""
- 'Alignment 2'
- 'Put' title
- 'Column 1'
- end
- 'SelectCell' out_cell
- 'CursorDown 2'
- 'Put' "Count:"
- 'CursorDown 1'
- 'Put' "Sum:"
- 'CursorDown 1'
- 'Put' "Mean:"
- 'CursorDown 2'
- 'GetCursorPos'
- restart_cell=result
- 'Put "Pooled Variance:"'
- 'CursorDown 1'
- 'Put "Std. Deviation:"'
- 'cursorDown 1'
- 'Put "St. Error:"'
- 'CursorDown 1'
- 'Put "t:"'
- 'CursorDown 1'
- 'Put "d.f.:"'
- 'CursorDown 1'
- 'Put "P(T<=t) one-tail:"'
- 'CursorDown 1'
- 'Put "T-Critical (95%):"'
- 'CursorDown 1'
- 'Put "T-Critical (99%):"'
- 'CursorDown 1'
- 'Put "P(T<=t) two-tail:"'
- 'CursorDown 1'
- 'Put "T-Critical (95%):"'
- 'CursorDown 1'
- 'Put "T-Critical (99%):"'
- do x=1 to NCols
- 'SelectCell' first_cell.x
- 'CursorDown 1'
- 'Put' count.x
- 'CursorDown 1'
- 'Put' total.x
- 'CursorDown 1'
- 'Put' format(mean.x,,4)
- end
- 'SelectCell' restart_cell
- 'Column 1'
- 'Put' format(Var,,4)
- 'CursorDown 1'
- 'Put' format(StDev,,4)
- 'CursorDown 1'
- 'Put' format(StErr,,4)
- 'CursorDown 1'
- 'Put' format(t,,4)
- 'CursorDown 1'
- 'Put' df
- 'CursorDown 1'
- 'Put' format(P,,6)
- 'CursorDown 1'
- 'Put' format(TCRIT1,,4)
- 'CursorDown 1'
- 'Put' format(TCRIT2,,4)
- 'CursorDown 1'
- 'Put' format(PT,,6)
- 'CursorDown 1'
- 'Put' format(TCRIT3,,4)
- 'CursorDown 1'
- 'Put' format(TCRIT4,,4)
- 'Refresh 1'
- 'Refresh 2'
- /*'Message' "Finished"*/
- /*indicate the main script is finished*/
- DisplayMsg="Cleaning up ...."||CR||"Exiting"
- result=writeln(6Info, DisplayMsg)
- if result~=0 then do
- /*Wait 3 seconds*/
- CALL DELAY(150)
- /* close window*/
- result=close(6Info)
- end
- 'DEFPUBSCREEN("Workbench")'
- exit
-
- /* Procedures */
-
- cellrow: procedure
- do
- parse arg cell
- do charpos=2 to length(cell)
- if datatype(substr(cell,charpos,1),n) then return substr(cell,charpos)
- end
- return 0
- end
- Return
-
- cellcol: procedure
- do
- parse arg cell
- labels="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- cell=upper(cell)
- len=length(cell)
- val=0
- do charpos=1 to len
- if datatype(substr(cell,charpos,1),n) then
- do cell=reverse(substr(cell,1,charpos-1))
- do x=1 to length(cell)
- val=(26**(x-1))*pos(substr(cell,x,1),labels)+val
- end
- return val
- end
- end
- return 0
- end
- Return
- /* It is important to put the exposed array at the end of the next line */
- Sort: procedure expose NCols NRows data.
- do x=1 to NCols
- L=(xtoy(2,int(log(NRows)/log(2))))-1
- Do Until L<1
- L=trunc(int(L/2))
- Do J=1 to L
- Do K=J+L To NRows By L
- I=K
- dumdat=data.x.I
- Do while I>L
- y=I-L
- If data.x.y ~> dumdat then Leave
- data.x.I=data.x.y
- I=I-L
- End
- data.x.I=dumdat
- End
- End
- End
- End
- Return
-
- syntax:
- if arg(1)='FAIL' then do
- 'Message "Library is unavailable."'
- 'DEFPUBSCREEN("Workbench")'
- exit
- end
- 'DEFPUBSCREEN("Workbench")'
- exit
-
- PROBT: PROCEDURE
-
- PARSE ARG TA,K1
- A=.36338023
- W=ATAN(TA/SQRT(K1))
- S=SIN(W)
- C=COS(W)
- L=K1-2*INT(K1/2)
- IF L=0 THEN DO
- T1=S
- IF K1=2 THEN DO
- PO=.5*(1+T1)
- RETURN PO
- END
- T2=S
- J1=-1
- J2=0
- K2=(K1-2)/2
- END
- ELSE DO
- T1=W
- IF K1=1 THEN DO
- T1=T1*(1-A*L)
- PO=.5*(1+T1)
- RETURN PO
- END
- T2=S*C
- T1=T1+T2
- IF K1=3 THEN DO
- T1=T1*(1-A*L)
- PO=.5*(1+T1)
- RETURN PO
- END
- J1=0
- J2=1
- K2=(K1-3)/2
- END
- DO I=1 TO K2
- J1=J1+2
- J2=J2+2
- T2=T2*C*C*J1/J2
- T1=T1+T2
- END
- T1=T1*(1-A*L)
- PO=.5*(1+T1)
- RETURN PO
-
- TCRITICAL: PROCEDURE
-
- PARSE ARG PO,K1
- AO=.0001
- E=.005
- E2=E+E
- A=2*PO-1
- IF K1=1 THEN DO
- TO=TAN(1.57079633*A)
- RETURN TO
- END
- IF K1=2 THEN DO
- SN=SIGN(2/(1-A*A))
- IF SN=-1 THEN TO=-1*(A*SQRT(ABS(2/(1-A*A))))
- ELSE TO=A*SQRT(2/(1-A*A))
- RETURN TO
- END
- P1=PO
- Z=NORMALPP(PO)
- W=Z*(1+2/(1+8*K1))
- T3=K1*(EXP(W*W/K1)-1)
- SELECT
- WHEN Z<0 THEN TT=-1
- WHEN Z=0 THEN TT=0
- OTHERWISE TT=1
- END
- SN=SIGN(T3)
- IF SN=-1 THEN T3=-1*(TT*SQRT(ABS(T3)))
- ELSE T3=TT*SQRT(T3)
- /*
- LABELA:
- TO=T3
- PO=PROBT(TO,K1)
- F1=PO-P1
- TO=T3+E
- PO=PROBT(TO,K1)
- F2=PO
- TO=T3-E
- PO=PROBT(TO,K1)
- F2=F2-PO
- F2=F2/E2
- T4=T3-F1/F2
- IF ABS(T4-T3)>AO THEN DO
- T3=T4
- SIGNAL 'LABELA'
- END
- */
- T4=0
- DO FOREVER
- TO=T3
- PO=PROBT(TO,K1)
- F1=PO-P1
- TO=T3+E
- PO=PROBT(TO,K1)
- F2=PO
- TO=T3-E
- PO=PROBT(TO,K1)
- F2=F2-PO
- F2=F2/E2
- T4=T3-F1/F2
- IF ABS(T4-T3)>AO THEN T3=T4
- ELSE LEAVE
- END
- TO=T4
-
- RETURN TO
-
- LOGGAMMA: PROCEDURE
-
- ARG XA
- C1=76.18009173
- C2=-86.50532033
- C3=24.01409822
- C4=-1.231739516
- C5=.001208580
- C6=-.000005364
- C7=2.506628275
- X1=XA-1
- W=X1+5.5
- W=(X1+.5)*LN(W)-W
- S=1+C1/(X1+1)+C2/(X1+2)+C3/(X1+3)
- S=S+C4/(X1+4)+C5/(X1+5)+C6/(X1+6)
- L=W+LN(C7*S)
- RETURN L
-
- NORMALPP: PROCEDURE
-
- ARG P0
- A1=2.515517
- A2=.802853
- A3=.010328
- A4=1.432788
- A5=.189269
- A6=.001308
- Q=.5-ABS(P0-.5)
- SN=SIGN(-2*LN(Q))
- IF SN=-1 THEN W=-1*SQRT(ABS(-2*LN(Q))
- ELSE W=SQRT(-2*LN(Q))
- W1=A1+W*(A2+A3*W)
- W2=1+W*(A4+W*(A5+A6*W))
- ZZ=W-W1/W2
- SELECT
- WHEN (P0-.5)<0 THEN TT=-1
- WHEN (P0-.5)=0 THEN TT=0
- otherwise TT=1
- END
- ZZ=ZZ*TT
- RETURN ZZ
-
- Format: procedure
-
- arg number, before, after
- CallLine = SIGL
- if ~datatype(CallLine, 'N') then CallLine = '??'
-
- /* Make sure we have a number as first (required) argument */
- if ~datatype(number, 'N') then do
- if number = '' then
- fc = 17 /* Wrong number of arguments */
- else
- fc = 47 /* Arithmetic conversion error */
- signal FormatSyntaxError
- end
- num = number + 0
- if before = '' & after = '' then
- return num
- else do
- parse var num integer '.' fraction
- if before = '' then before = length(integer)
- if after = '' then after = length(fraction)
- if ~datatype(before, N) | ~datatype(after, N) then
- do fc = 18
- signal FormatSyntaxError
- end
- if before < length(integer) then do
- fc = 18
- signal FormatSyntaxError
- end
- if after ~= length(fraction) then do
- fraction = trunc(('.'fraction'0') + ('.'copies('0', after)'5'), after)
- integer = integer + (fraction % 1)
- fraction = substr(fraction, 3)
- end
- if fraction >= 0 then
- return right(integer, before)'.'fraction
- else
- return right(integer, before)
- end
-
- FormatSyntaxError:
- if show('F', STDERR) then
- call writeln(STDERR, '+++ Error' fc 'in line' CallLine':' errortext(fc))
- else
- mess='+++ Error' fc 'in line' CallLine':' errortext(fc)
- 'Message' mess
- parse source Func .
- if Func = 'FUNCTION' then do
- 'DEFPUBSCREEN("Workbench")'
- exit "Err"
- end
- else do
- 'DEFPUBSCREEN("Workbench")'
- exit 10
- end